home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / Intro_to_T2013918162006.psc / Intro to Texture Mapping / frmMain.frm < prev    next >
Text File  |  2006-08-16  |  11KB  |  316 lines

  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    Caption         =   "Intro to Texture Mapping - By Hou Xiong"
  4.    ClientHeight    =   7665
  5.    ClientLeft      =   60
  6.    ClientTop       =   450
  7.    ClientWidth     =   11310
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   7665
  10.    ScaleWidth      =   11310
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.CheckBox Check1 
  13.       Caption         =   "Step Through"
  14.       Height          =   495
  15.       Left            =   7920
  16.       TabIndex        =   5
  17.       Top             =   3120
  18.       Width           =   2175
  19.    End
  20.    Begin VB.CommandButton Command4 
  21.       Caption         =   "Start 3D Rotation"
  22.       Height          =   495
  23.       Left            =   7920
  24.       TabIndex        =   4
  25.       Top             =   2520
  26.       Width           =   2175
  27.    End
  28.    Begin VB.CommandButton Command3 
  29.       Caption         =   "Draw Textured Trapezoid"
  30.       Height          =   495
  31.       Left            =   7920
  32.       TabIndex        =   3
  33.       Top             =   1920
  34.       Width           =   2175
  35.    End
  36.    Begin VB.CommandButton Command2 
  37.       Caption         =   "Draw Trapeziod"
  38.       Height          =   495
  39.       Left            =   7920
  40.       TabIndex        =   2
  41.       Top             =   1320
  42.       Width           =   2175
  43.    End
  44.    Begin VB.CommandButton Command1 
  45.       Caption         =   "Draw Triangle"
  46.       Height          =   495
  47.       Left            =   7920
  48.       TabIndex        =   1
  49.       Top             =   720
  50.       Width           =   2175
  51.    End
  52.    Begin VB.PictureBox scene 
  53.       BackColor       =   &H00FFFFFF&
  54.       Height          =   5655
  55.       Left            =   360
  56.       ScaleHeight     =   373
  57.       ScaleMode       =   3  'Pixel
  58.       ScaleWidth      =   469
  59.       TabIndex        =   0
  60.       Top             =   360
  61.       Width           =   7095
  62.    End
  63. End
  64. Attribute VB_Name = "frmMain"
  65. Attribute VB_GlobalNameSpace = False
  66. Attribute VB_Creatable = False
  67. Attribute VB_PredeclaredId = True
  68. Attribute VB_Exposed = False
  69. Option Explicit
  70.  
  71. ' Intro to Texture Mapping
  72. ' By: Hou Xiong
  73.  
  74. ' This is a very basic intro into custom texture mapping.
  75. ' It shows the small differences between drawing a
  76. ' simple triangle to a trapezoid to a 3d texture.
  77. ' It also features a simple 3d texture animation.
  78.  
  79. 'Trig constants
  80. Private Const PI = 3.141592653
  81. Private Const DEGREES = 180 / PI
  82. Private Const RADIANS = PI / 180
  83.  
  84. 'Simplifies gdi functions through my custom classes
  85. Dim BackBuffer As SurfaceGDI
  86. Dim Texture1 As SurfaceGDI
  87. 'arrays for direct access bitmaps
  88. Dim bbfbits() As Long
  89. Dim tex1Bits() As Long
  90.  
  91. Dim doRotation As Boolean
  92. Dim timeToEnd As Boolean
  93. Dim angle As Single
  94.  
  95. Private Sub Check1_Click()
  96.     'uncomment the code in each draw functions
  97.     MsgBox "Uncomment code first."
  98. End Sub
  99.  
  100. Private Sub Command1_Click()
  101.     BackBuffer.Clear
  102.     'vertices start from top left going clock-wise
  103.     DrawTriangle 30, 150, 300, 50, 300, 300
  104.     BackBuffer.FlipBuffer scene.hDC
  105. End Sub
  106.  
  107. Private Sub Command2_Click()
  108.     BackBuffer.Clear
  109.     'vertices start from top left going clock-wise
  110.     DrawTrap 30, 150, 300, 50, 300, 300, 30, 200
  111.     BackBuffer.FlipBuffer scene.hDC
  112. End Sub
  113.  
  114. Private Sub Command3_Click()
  115.     BackBuffer.Clear
  116.     'vertices start from top left going clock-wise
  117.     DrawTrapTex 30, 150, 300, 50, 300, 300, 30, 200
  118.     BackBuffer.FlipBuffer scene.hDC
  119. End Sub
  120.  
  121. Private Sub DrawTriangle(ByVal x0 As Long, ByVal y0 As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long)
  122.     Dim y_start As Single, y_end As Single
  123.     Dim y_top_change As Single, y_bottom_change As Single
  124.     Dim y As Long, x As Long
  125.     
  126.     y_start = y0    'initialize vertical line start and end (in pixels of course)
  127.     y_end = y0      'since it's a triangle, the start and end would be the same of the first vertex
  128.     If x1 = x0 Then Exit Sub 'nothing to draw, prevents divide by zero
  129.     y_top_change = (y1 - y0) / (x1 - x0)    'these are basically the slopes (rise/run)
  130.     y_bottom_change = (y2 - y0) / (x1 - x0) 'in the top and bottom edges, these tell how much to move up or down each time we move right a scan line
  131.     
  132.     'scan across vertical lines going right
  133.     For x = x0 To x1
  134.         'go down the line and set the color bits
  135.         For y = y_start To y_end
  136.             bbfbits(x, y) = vbBlue  'will turn out red because of reverse BGR format
  137.             'step through, comment out for speed gain
  138.             'If Check1.Value = vbChecked Then
  139.             '    DoEvents
  140.             '    BackBuffer.FlipBuffer scene.hDC
  141.             'End If
  142.         Next
  143.         
  144.         'update the line start and end
  145.         y_start = y_start + y_top_change
  146.         y_end = y_end + y_bottom_change
  147.     Next
  148. End Sub
  149.  
  150. 'This algorithm automatically removes/ignores backfaces.
  151. 'Compare to DrawTriangle().
  152. 'A new point is added and a few lines updated from DrawTriangle to allow drawing trapezoid.
  153. Private Sub DrawTrap(ByVal x0 As Long, ByVal y0 As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long, ByVal x3 As Long, ByVal y3 As Long)
  154.     Dim y_start As Single, y_end As Single
  155.     Dim y_top_change As Single, y_bottom_change As Single
  156.     Dim x As Long, y As Long
  157.     
  158.     y_start = y0
  159.     y_end = y3                          'updated from DrawTriangle
  160.     If x1 = x0 Then Exit Sub
  161.     y_top_change = (y1 - y0) / (x1 - x0)
  162.     y_bottom_change = (y2 - y3) / (x1 - x0)   'updated from DrawTriangle
  163.     
  164.     For x = x0 To x1
  165.         For y = y_start To y_end
  166.             If (x >= 0) And (x < BackBuffer.width) And (y >= 0) And (y < BackBuffer.height) Then
  167.                 bbfbits(x, y) = vbRed   'will turn out blue because of reverse BGR format
  168.                 'step through, comment out for speed gain
  169.                 'If Check1.Value = vbChecked Then
  170.                 '    DoEvents
  171.                 '    BackBuffer.FlipBuffer scene.hDC
  172.                 'End If
  173.             End If
  174.         Next
  175.         
  176.         y_start = y_start + y_top_change
  177.         y_end = y_end + y_bottom_change
  178.     Next
  179. End Sub
  180.  
  181. 'This algorithm automatically removes/ignores backfaces.
  182. 'Compare to DrawTrap()
  183. 'Only a few added lines to allow for texture mapping.
  184. Private Sub DrawTrapTex(ByVal x0 As Long, ByVal y0 As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long, ByVal x3 As Long, ByVal y3 As Long)
  185.     Dim y_start As Single, y_end As Single
  186.     Dim y_top_change As Single, y_bottom_change As Single
  187.     Dim x As Long, y As Long
  188.     Dim u As Single, v As Single    'new from DrawTrap
  189.     Dim du As Single, dv As Single  'new from DrawTrap
  190.     
  191.     y_start = y0
  192.     y_end = y3
  193.     If x1 = x0 Then Exit Sub
  194.     y_top_change = (y1 - y0) / (x1 - x0)
  195.     y_bottom_change = (y2 - y3) / (x1 - x0)
  196.     
  197.     du = (Texture1.width - 1) / (x1 - x0)  'new from DrawTrap
  198.     
  199.     For x = x0 To x1
  200.         dv = (Texture1.height - 1) / (y_end - y_start)   'new from DrawTrap
  201.         v = 0                                           'new from DrawTrap
  202.         For y = y_start To y_end
  203.             If (x >= 0) And (x < BackBuffer.width) And (y >= 0) And (y < BackBuffer.height) Then
  204.                 On Error Resume Next
  205.                 bbfbits(x, y) = tex1Bits(u, v)    'updated from DrawTrap
  206.                 'step through, comment out for speed gain
  207.                 'If Check1.Value = vbChecked Then
  208.                 '    DoEvents
  209.                 '    BackBuffer.FlipBuffer scene.hDC
  210.                 'End If
  211.             End If
  212.             v = v + dv  'new from DrawTrap
  213.         Next
  214.         
  215.         y_start = y_start + y_top_change
  216.         y_end = y_end + y_bottom_change
  217.         u = u + du  'new from DrawTrap
  218.     Next
  219. End Sub
  220.  
  221. Private Sub Command4_Click()
  222.     If doRotation Then
  223.         doRotation = False
  224.     Else
  225.         Command4.Caption = "Stop 3D Rotation"
  226.         doRotation = True
  227.         
  228.         Dim x1 As Single, y As Single, z1 As Single
  229.         Dim x2 As Single, z2 As Single, zTrans As Single
  230.         Dim angle As Single
  231.         Dim halfWidth As Single, halfHeight As Single
  232.         Dim x2d1 As Long, y2d1 As Long, x2d2 As Long, y2d2 As Long
  233.         Dim xCenter As Long, yCenter As Long
  234.         Dim convScl As Long
  235.         
  236.         'surface dimensions
  237.         halfWidth = Texture1.width
  238.         halfHeight = Texture1.height
  239.         y = halfHeight
  240.         
  241.         zTrans = 1500
  242.         xCenter = BackBuffer.width / 2
  243.         yCenter = BackBuffer.height / 2
  244.         convScl = BackBuffer.width
  245.         
  246.     
  247.         Do While doRotation
  248.             DoEvents
  249.             BackBuffer.Clear
  250.             
  251.             'calculate the rotation
  252.             x1 = Cos(angle * RADIANS) * halfWidth
  253.             z1 = Sin(angle * RADIANS) * halfWidth
  254.             'since our rotation is done in the center
  255.             'just invert the first vertex for the adjacent vertex
  256.             x2 = -x1
  257.             z2 = -z1
  258.             
  259.             'z translation
  260.             z1 = z1 + zTrans
  261.             z2 = z2 + zTrans
  262.             
  263.             'x translation
  264.             x1 = x1 + 0
  265.             x2 = x2 + 0
  266.             
  267.             'convert to 2D coordinates
  268.             'we'll just keep our rotation centered along the Y-axis so we'll
  269.             'use only two verteces then flip them later for the top two vertices
  270.             x2d2 = convScl * x1 / z1
  271.             y2d2 = convScl * y / z1
  272.             x2d1 = convScl * x2 / z2
  273.             y2d1 = convScl * y / z2
  274.             
  275.             angle = angle + 1
  276.             
  277.             DrawTrapTex x2d1 + xCenter, -y2d1 + yCenter, x2d2 + xCenter, -y2d2 + yCenter, x2d2 + xCenter, y2d2 + yCenter, x2d1 + xCenter, y2d1 + yCenter
  278.             'DrawTrap x2d1 + xCenter, -y2d1 + yCenter, x2d2 + xCenter, -y2d2 + yCenter, x2d2 + xCenter, y2d2 + yCenter, x2d1 + xCenter, y2d1 + yCenter
  279.             'draw back face
  280.             DrawTrap x2d2 + xCenter, -y2d2 + yCenter, x2d1 + xCenter, -y2d1 + yCenter, x2d1 + xCenter, y2d1 + yCenter, x2d2 + xCenter, y2d2 + yCenter
  281.             
  282.             BackBuffer.FlipBuffer scene.hDC
  283.         Loop
  284.         Command4.Caption = "Start 3D Rotation"
  285.         If timeToEnd Then
  286.             'clean up gdi surfaces
  287.             BackBuffer.DeleteSurface
  288.             Texture1.DeleteSurface
  289.             EraseLongPointer bbfbits()
  290.             EraseLongPointer tex1Bits()
  291.             Unload Me
  292.         End If
  293.     End If
  294. End Sub
  295.  
  296. Private Sub Form_Load()
  297.     'Initialize gdi surfaces
  298.     Set BackBuffer = CreateSurface(scene.ScaleWidth, scene.ScaleHeight)
  299.     Set Texture1 = CreateSurfaceFromFile(App.Path & "\Texture.bmp")
  300.     BackBuffer.MakeLongPointer bbfbits()
  301.     Texture1.MakeLongPointer tex1Bits()
  302. End Sub
  303.  
  304. Private Sub Form_Unload(Cancel As Integer)
  305.     If Not doRotation Then
  306.         'clean up gdi surfaces
  307.         BackBuffer.DeleteSurface
  308.         Texture1.DeleteSurface
  309.         EraseLongPointer bbfbits()
  310.         EraseLongPointer tex1Bits()
  311.     Else
  312.         doRotation = False
  313.         timeToEnd = True
  314.     End If
  315. End Sub
  316.